home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 / Ham Radio 2000.iso / ham2000 / packet / terminal / top_152 / src152.exe / rar / TOPPASS.PAS < prev    next >
Pascal/Delphi Source File  |  1995-05-16  |  14KB  |  503 lines
  1. {┌─────────────────────────────────────────────────────────────────────────┐}
  2. {│                                                                         │}
  3. {│                              T. O. P.                                   │}
  4. {│                                                                         │}
  5. {│                        (T)he  (O)ther  (P)acket                         │}
  6. {│                                                                         │}
  7. {│ T O P P A S S . P A S                                                   │}
  8. {│                                                                         │}
  9. {│ Enthält notwendige Routinen zum Einloggen als SYSOP in den              │}
  10. {│ verschiedenen Systemen.                                                 │}
  11. {└─────────────────────────────────────────────────────────────────────────┘}
  12.  
  13.  
  14. Procedure Sysop_Einloggen (* Kanal : Byte; Zeile : Str80 *);
  15. Var    i,i1 : Byte;
  16.        Flag : Boolean;
  17.        Hstr : String[80];
  18.        Astr : String[5];
  19.  
  20. Begin
  21.   with K[Kanal]^ do
  22.   begin
  23.     if SysopParm then
  24.     begin
  25.       SysopParm := false;
  26.       InfoOut(Kanal,0,1,InfoZeile(3));
  27.     end else
  28.     begin
  29.       Flag := false;
  30.       Zeile := RestStr(UpCaseStr(Zeile));
  31.       KillEndBlanks(Zeile);
  32.       Astr := Zeile;
  33.  
  34.       if SysArt in [1,2,5..11,13,14] then
  35.       begin
  36.         Astr := SNam[SysArt];
  37.         Flag := true;
  38.         SysopStr := ParmStr(SysArt,B1,InfoZeile(217));
  39.       end else if SCon[0] then
  40.       begin
  41.         for i := 1 to maxUser do if not Flag and (Astr = UNam[i]) then
  42.         begin
  43.           Flag := true;
  44.           UserArt := i;
  45.           SysopStr := ParmStr(UserArt,B1,InfoZeile(218));
  46.         end;
  47.       end;
  48.       if not Flag then InfoOut(Kanal,1,1,InfoZeile(171));
  49.  
  50.       if Flag then
  51.       begin
  52.         Flag := false;
  53.         KillEndBlanks(Astr);
  54.         SysopArt := LRK + Astr + RRK;
  55.         Assign(G^.TFile,Sys1Pfad + PwDatei);
  56.         FiResult := ResetTxt(G^.TFile);
  57.         While not Eof(G^.TFile) and not Flag do
  58.         begin
  59.           Readln(G^.TFile,Hstr);
  60.           if Found_Pw_Call(Hstr,Call,SysopArt) then
  61.           begin
  62.             Flag := true;
  63.             PassRetry := Byte(str_int(GetPwParm(1,Hstr)));
  64.           end;
  65.         end;
  66.         FiResult := CloseTxt(G^.TFile);
  67.         if not Flag then
  68.            InfoOut(Kanal,1,1,InfoZeile(17) + B1 + SysopArt + B1 + Call);
  69.       end;
  70.  
  71.       if Flag then
  72.       begin
  73.         Randomize;
  74.         PassRight := 1;
  75.         inc(PassRetry);
  76.         if PassRetry > 1 then
  77.         begin
  78.           PassRight := Random(PassRetry+1);
  79.           if PassRight = 0 then PassRight := 1;
  80.         end;
  81.  
  82.         case SysArt of
  83.           1 : begin   (* DBOX *)
  84.                 if not DBoxScaned then Scan_PW_Array(Kanal);
  85.                 SysopStr := SysopStr + B1 + DieBoxPW;
  86.               end;
  87.  
  88.          else SysopParm := true;
  89.         end;
  90.  
  91.         InfoOut(Kanal,0,1,SysopStr);
  92.         S_PAC(Kanal,NU,true,SysopStr + M1);
  93.       end;
  94.     end;
  95.   end;
  96. End;
  97.  
  98.  
  99. Procedure Password_Auswert (* Kanal : Byte; Zeile : String *);
  100. Begin
  101.   with K[Kanal]^ do if SysArt in [0,2,3,5..11,13,14] then
  102.   begin
  103.     case SysArt of
  104.       0 : case UserArt of
  105.             1 : TheNet_SYS_Auswert(Kanal,Zeile);  (* TOP  *)
  106.             2 : RMNC_Auswert(Kanal,Zeile);        (* SP   *)
  107.           end;
  108.       5 : EZBOX_Auswert(Kanal,Zeile);      (* EBOX *)
  109.       7 : RMNC_Auswert(Kanal,Zeile);       (* RMNC *)
  110.       2,                                   (* BBOX *)
  111.       3,                                   (* FBOX *)
  112.       6,                                   (* BDXL *)
  113.       8,                                   (* TNN  *)
  114.       9,                                   (* NETR *)
  115.      10,                                   (* BN   *)
  116.      11,                                   (* DXC  *)
  117.      13,                                   (* FALC *)
  118.      14 : TheNet_SYS_Auswert(Kanal,Zeile); (* TNC3 *)
  119.     end;
  120.   end;
  121.   SetzeFlags(Kanal);
  122. End;
  123.  
  124.  
  125. Procedure DieBox_PW_Scan (* Kanal : Byte; Zeile : String; *);
  126. var   Flag : Boolean;
  127. Begin
  128.   with K[Kanal]^ do
  129.   begin
  130.     Flag := false;
  131.     if length(Zeile) > 14 then
  132.     Repeat
  133.       if (Zeile[3] = Pkt ) then
  134.          if (Zeile[6] = Pkt ) then
  135.             if (Zeile[9] = B1) then
  136.                if (Zeile[12] = DP) then Flag := true;
  137.       if not Flag then delete(Zeile,1,1);
  138.     Until Flag or (length(Zeile) < 14);
  139.     if Flag then DieBoxPW := copy(Zeile,1,2) +
  140.                              copy(Zeile,10,2) +
  141.                              copy(Zeile,13,2);
  142.   end;
  143. End;
  144.  
  145.  
  146. Procedure Scan_PW_Array (* Kanal : Byte *);
  147. Var   Pw   : ^PWArrayPtr;
  148.       Hstr : String[162];
  149.       Flag : Boolean;
  150.       i    : Byte;
  151.       Std,
  152.       Min,
  153.       Tag  : Byte;
  154.       w    : Word;
  155. Begin
  156.   with K[Kanal]^ do
  157.   begin
  158.     DBoxScaned := false;
  159.     Assign(G^.TFile,Sys1Pfad + PwDatei);
  160.     FiResult := ResetTxt(G^.TFile);
  161.     Repeat
  162.       Readln(G^.TFile,Hstr);
  163.       Flag := Found_Pw_Call(Hstr,Call,LRK + SNam[1] + RRK);
  164.     Until Flag or Eof(G^.TFile);
  165.     if Flag then
  166.     begin
  167.       GetMem(Pw,SizeOf(Pw^));
  168.       FillChar(Pw^,SizeOf(Pw^),0);
  169.       w := 0;
  170.       Repeat
  171.         Readln(G^.TFile,Hstr);
  172.         KillEndBlanks(Hstr);
  173.         i := length(Hstr);
  174.         if w + i <= maxDBoxPwCh then move(Hstr[1],Pw^[w+1],i);
  175.         w := w + i;
  176.       Until (w >= maxDBoxPwCh) or Eof(G^.TFile) or (Hstr = '');
  177.  
  178.       if w = maxDBoxPwCh then
  179.       begin
  180.         Tag := Byte(str_int(copy(DieBoxPW,1,2)));
  181.         Std := Byte(str_int(copy(DieBoxPW,3,2)));
  182.         Min := Byte(str_int(copy(DieBoxPW,5,2)));
  183.         w := ((Min + Tag) mod 60) * 27 + Std + 1;
  184.         if w + 3 <= maxDBoxPwCh then
  185.         begin
  186.           move(Pw^[w],DieBoxPW[1],4);
  187.           DieBoxPW[0] := Chr(4);
  188.           DBoxScaned := true;
  189.         end;
  190.       end else InfoOut(Kanal,1,1,InfoZeile(317) + B1 + int_str(w));
  191.       FreeMem(Pw,SizeOf(Pw^));
  192.     end;
  193.     FiResult := CloseTxt(G^.TFile);
  194.   end;
  195. End;
  196.  
  197.  
  198. Procedure BayBox_US_Scan (* Kanal : Byte; Zeile : String *);
  199. Begin
  200.   with K[Kanal]^ do
  201.   begin
  202.     PassRetry := 1;
  203.     PassRight := 1;
  204.     SysopArt := BBUS;
  205.     TheNet_SYS_Auswert(Kanal,Zeile);
  206.   end;
  207. End;
  208.  
  209. Function  PseudoPriv (* Laenge : Byte; Pstr : Str20; Dstr : Str80) : Str80 *);
  210. Var   i     : Byte;
  211.       w     : Word;
  212.       Feld  : Array [1..6] of Byte;
  213.       Hstr  : String[80];
  214.       Flag  : Boolean;
  215. Begin
  216.   Randomize;
  217.   w := 0;
  218.  
  219.   Hstr := CutStr(Dstr);
  220.   delete(Hstr,1,1);
  221.   delete(Hstr,length(Hstr),1);
  222.   Flag := Hstr = SNam[2];
  223.  
  224.   Dstr := ParmStr(2,B1,Dstr);
  225.   delete(Dstr,1,1);
  226.   delete(Dstr,length(Dstr),1);
  227.  
  228.   for i := 1 to 6 do Feld[i] := 0;
  229.   for i := 1 to 3 do
  230.   begin
  231.     Hstr := ParmStr(2+i,Km,Dstr);
  232.     if (length(Hstr) = 4) and (Hstr[4] >= Hstr[1]) then
  233.     begin
  234.       Feld[2*i-1] := ord(Hstr[1]);
  235.       Feld[2*i] := ord(Hstr[4]);
  236.       w := w + Feld[2*i-1] + Feld[2*i];
  237.     end;
  238.   end;
  239.  
  240.   Hstr := '';
  241.   if w = 0 then
  242.   begin
  243.     Feld[1] := 48;
  244.     Feld[2] := 122;
  245.   end;
  246.  
  247.   Repeat
  248.     i := Random(254);
  249.     if Flag and (i in [35,44,59]) then i := 0;
  250.     if (i > 0) and
  251.        (i in [Feld[1]..Feld[2],Feld[3]..Feld[4],Feld[5]..Feld[6]]) then
  252.       Hstr := Hstr + Chr(i);
  253.   Until length(Hstr) >= Laenge;
  254.  
  255.   if Pstr > '' then
  256.   begin
  257.     i := Random(Byte(Laenge-length(Pstr)));
  258.     if i = 0 then i := 1;
  259.     delete(Hstr,i,length(Pstr));
  260.     insert(Pstr,Hstr,i);
  261.   end;
  262.   PseudoPriv := Hstr;
  263. End;
  264.  
  265.  
  266. Function  GetPwParm (* Nr : Byte; Zeile : Str80) : Str20 *);
  267. Var  i,i1 : Byte;
  268. Begin
  269.   Zeile := ParmStr(2,B1,Zeile);
  270.   i := pos(LRK,Zeile);
  271.   i1 := pos(RRK,Zeile);
  272.   if (i = 1) and (i1 > 2) then
  273.   begin
  274.     delete(Zeile,1,1);
  275.     delete(Zeile,length(Zeile),1);
  276.     GetPwParm := ParmStr(Nr,Km,Zeile);
  277.   end else GetPwParm := '';
  278. End;
  279.  
  280. Function  Found_Pw_Call (* Zeile : Str80; Cstr : Str9; AStr : Str6) : Boolean *);
  281. Var   i    : Byte;
  282.       Flag : Boolean;
  283. Begin
  284.   KillEndBlanks(AStr);
  285.   Flag := pos(AStr,Zeile) = 1;
  286.  
  287.   if Flag then
  288.   Repeat
  289.     Zeile := RestStr(Zeile);
  290.     Flag := Cstr = CutStr(Zeile);
  291.   Until Flag or (length(Zeile) = 0);
  292.  
  293.   Found_Pw_Call := Flag;
  294. End;
  295.  
  296.  
  297. Function  Check_Parm (* Zeile : String) : String *);
  298. Var  i,i1 : Byte;
  299.      Bstr : String;
  300. Begin
  301.   i := pos('> ',Zeile);
  302.   if i > 0 then delete(Zeile,1,i-1);
  303.  
  304.   Bstr := '';
  305.   i := 0;
  306.   i1 := length(Zeile);
  307.   While i < i1 do
  308.   begin
  309.     inc(i);
  310.     if Zeile[i] in ['0'..'9',B1] then Bstr := Bstr + Zeile[i]
  311.                                   else Bstr := Bstr + B1;
  312.   end;
  313.   KillStartBlanks(Bstr);
  314.   KillEndBlanks(Bstr);
  315.   Check_Parm := Bstr;
  316. End;
  317.  
  318.  
  319. Procedure RMNC_Auswert (* Kanal : Byte; Zeile : Str80 *);
  320. var    i,iz    : Integer;
  321.        PrivStr : String[80];
  322.        Bstr    : String[20];
  323.        Found   : Boolean;
  324.  
  325. Begin
  326.   with K[Kanal]^ do
  327.   begin
  328.     While pos(B1,Zeile) > 0 do Zeile := RestStr(Zeile);
  329.     While pos(M1,Zeile) > 0 do Zeile[pos(M1,Zeile)] := B1;
  330.     While pos(^J,Zeile) > 0 do Zeile[pos(^J,Zeile)] := B1;
  331.     While pos(RSK,Zeile) > 0 do Zeile[pos(RSK,Zeile)] := B1;
  332.  
  333.     KillStartBlanks(Zeile);
  334.     KillEndBlanks(Zeile);
  335.  
  336.     if str_int(Zeile) > 0 then
  337.     begin
  338.       if PassRetry <> PassRight then
  339.       begin
  340.         Repeat
  341.           iz := Random(255);
  342.         Until iz in [21..255];
  343.         InfoOut(Kanal,0,1,ParmStr(2,B1,InfoZeile(241)) + B2 + Zeile + PfStr + int_str(iz));
  344.         S_PAC(Kanal,NU,true,int_str(iz) + M1);
  345.       end else
  346.       begin
  347.         PrivStr := Zeile;
  348.         Bstr := '';
  349.         for i := 1 to length(PrivStr) do if PrivStr[i] in ['0'..'9'] then
  350.          Bstr := Bstr + PrivStr[i];
  351.         While length(Bstr) < 5 do Bstr := '0' + Bstr;
  352.  
  353.         Assign(G^.TFile,Sys1Pfad + PwDatei);
  354.         FiResult := ResetTxt(G^.TFile);
  355.         Found := false;
  356.         Repeat
  357.           Readln(G^.TFile,PrivStr);
  358.           if Found_Pw_Call(PrivStr,Call,SysopArt) then Found := true;
  359.         Until Found or Eof(G^.TFile);
  360.  
  361.         if Found then
  362.         begin
  363.           iz := 0;
  364.           Readln(G^.TFile,PrivStr);
  365.           for i := 1 to length(Bstr) do
  366.             iz := iz + (str_int(Bstr[i]) * str_int(PrivStr[i]));
  367.           InfoOut(Kanal,0,1,ParmStr(1,B1,InfoZeile(241)) + B2 + Zeile + PfStr + int_str(iz));
  368.           S_PAC(Kanal,NU,true,int_str(iz) + M1);
  369.         end else
  370.         begin
  371.           SysopParm := false;
  372.           InfoOut(Kanal,1,1,InfoZeile(171));
  373.         end;
  374.         FiResult := CloseTxt(G^.TFile);
  375.       end;
  376.  
  377.       if PassRetry > 1 then S_PAC(Kanal,NU,true,SysopStr + M1);
  378.       dec(PassRetry);
  379.       if PassRetry < 1 then SysopParm := false;
  380.     end;
  381.   end;
  382. End;
  383.  
  384.  
  385. Procedure TheNet_SYS_Auswert (* (Kanal : Byte; Zeile : String) *);
  386. var  i,i1,r,
  387.      AnzParam : Byte;
  388.      PsConst,
  389.      PwConst  : Byte;
  390.      Dstr,
  391.      Rstr,
  392.      Pstr,
  393.      Hstr     : String[80];
  394.      Found    : Boolean;
  395.  
  396. Begin
  397.   with K[Kanal]^ do
  398.   begin
  399.     Zeile := Check_Parm(Zeile);
  400.     Pstr := ParmStr(1,B1,Zeile);
  401.     AnzParam := ParmAnz;
  402.     Pstr := '';
  403.  
  404.     Assign(G^.TFile,Sys1Pfad + PwDatei);
  405.     FiResult := ResetTxt(G^.TFile);
  406.     Repeat
  407.       Readln(G^.TFile,Hstr);
  408.       Found := Found_Pw_Call(Hstr,Call,SysopArt);
  409.     Until Found or Eof(G^.TFile);
  410.  
  411.     if Found then
  412.     begin
  413.       Dstr := Hstr;
  414.       if SysArt = 11 then PwConst := 4
  415.                      else PwConst := 5;
  416.       if AnzParam = PwConst then
  417.       begin
  418.         PsConst := Byte(str_int(GetPwParm(2,Dstr)));
  419.         if PassRetry <> PassRight then
  420.         begin
  421.           Pstr := PseudoPriv(PsConst,'',Dstr);
  422.           InfoOut(Kanal,0,1,ParmStr(2,B1,InfoZeile(241)) + B2 +
  423.                             Zeile + PfStr + copy(Pstr,1,PwConst));
  424.           S_PAC(Kanal,NU,true,Pstr + M1);
  425.         end else
  426.         begin
  427.           Pstr := '';
  428.           Readln(G^.TFile,Hstr);
  429.           for i := 1 to PwConst do
  430.           begin
  431.             i1 := Byte(str_int(ParmStr(i,B1,Zeile)));
  432.             Pstr := Pstr + copy(Hstr,i1,1);
  433.           end;
  434.           Rstr := Pstr;
  435.           if PsConst > PwConst then Pstr := PseudoPriv(PsConst,Pstr,Dstr);
  436.           InfoOut(Kanal,0,1,
  437.             ParmStr(1,B1,InfoZeile(241)) + B2 + Zeile + PfStr + Rstr);
  438.           S_PAC(Kanal,NU,true,Pstr + M1);
  439.         end;
  440.  
  441.         if PassRetry > 1 then S_PAC(Kanal,NU,true,SysopStr + M1);
  442.         dec(PassRetry);
  443.         if PassRetry < 1 then SysopParm := false;
  444.       end;
  445.     end else
  446.     begin
  447.       SysopParm := false;
  448.       if RxLines >= 1 then InfoOut(Kanal,1,1,InfoZeile(171));
  449.     end;
  450.  
  451.     FiResult := CloseTxt(G^.TFile);
  452.   end;
  453. End;
  454.  
  455.  
  456. Procedure EZBOX_Auswert (* Kanal : Byte; Zeile : Str80 *);
  457. var  b,i,i1 : Byte;
  458.      Pstr   : String[4];
  459.      Rstr   : String[20];
  460.      Hstr   : String[80];
  461.      Found  : Boolean;
  462. Begin
  463.   with K[Kanal]^ do
  464.   begin
  465.     if (copy(Zeile,1,1) = LRK) and (copy(Zeile,length(Zeile),1) = RSK) then
  466.     begin
  467.       delete(Zeile,1,1);
  468.       delete(Zeile,length(Zeile),1);
  469.       KillEndBlanks(Zeile);
  470.       delete(Zeile,length(Zeile),1);
  471.       While pos('.',Zeile) > 0 do Zeile[pos('.',Zeile)] := B1;
  472.       Rstr := Zeile;
  473.  
  474.       Assign(G^.TFile,Sys1Pfad + PwDatei);
  475.       FiResult := ResetTxt(G^.TFile);
  476.       Repeat
  477.         Readln(G^.TFile,Hstr);
  478.         Found := Found_Pw_Call(Hstr,Call,SysopArt);
  479.       Until Found or Eof(G^.TFile);
  480.  
  481.       if Found then
  482.       begin
  483.         Pstr := '';
  484.         Readln(G^.TFile,Hstr);
  485.         b := Ord(Hstr[Byte(str_int(CutStr(Zeile)))]);
  486.         Zeile := RestStr(Zeile);
  487.         for i := 1 to 4 do
  488.         begin
  489.           i1 := Byte(b + Byte(str_int(CutStr(Zeile))));
  490.           i1 := i1 mod 80;
  491.           if i1 = 0 then i1 := 80;
  492.           Pstr := Pstr + Hstr[i1];
  493.           Zeile := RestStr(Zeile);
  494.         end;
  495.         InfoOut(Kanal,0,1,ParmStr(1,B1,InfoZeile(241)) + B2 + Rstr + PfStr + Pstr);
  496.         S_PAC(Kanal,NU,true,Pstr + M1);
  497.       end else InfoOut(Kanal,1,1,InfoZeile(171));
  498.       SysopParm := false;
  499.       FiResult := CloseTxt(G^.TFile);
  500.     end;
  501.   end;
  502. End;
  503.